;;; cl-synth : A software synthesiser for Common Lisp
;;; Copyright (C) 2010  Richard van Roy - (pluijzer [at] gmail [dot] com)

;;; This program is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation, either version 3 of the License, or
;;; (at your option) any later version.

;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.

;;; You should have received a copy of the GNU General Public License
;;; along with this program.  If not, see <http://www.gnu.org/licenses/>

(in-package :cl-synth)

(defparameter bit-range
  ;; Rounded two down to prevent rounding artifacts
  (- (/ (floor #xffff) 2) 2))

(defun float-list-to-binary (list)
  (mapcan (lambda (x) (integer-to-binary
		       (round (* bit-range x)) 2)) list))

(defun integer-to-binary (value bytes)
  (loop for i from 0 to (- (* bytes 8) 1) by 8
     collect (ldb (byte 8 i) value)))

(defun string-to-binary (string)
  (loop for i in (coerce string 'list)
     collect (first (integer-to-binary (char-code i) 1))))
       
(defun riff-chunk (size)
  (append (string-to-binary "RIFF")
	  (integer-to-binary size 4)
	  (string-to-binary "WAVE")))

;; FIXME: Premature EOF on .wav input file
(defun fmt-chunk (channels samplerate bps)
  (append (string-to-binary "fmt ")
	  (integer-to-binary 16 4)
	  (integer-to-binary 1 2)
	  (integer-to-binary channels 2)
	  (integer-to-binary samplerate 4)
	  (integer-to-binary (/ (* samplerate
				   channels
				   bps) 8) 4)
	  (integer-to-binary (/ (* channels
				   bps) 8) 2)
	  (integer-to-binary bps 2)))

(defun data-chunk (bps data)
  (append (string-to-binary "data")
	  (integer-to-binary (/ (* (length data) bps) 8) 4)
	  data))

(defun wave-struct (channels samplerate bps data)
  (append (riff-chunk 
	   (+ 36 (/ (* (length data) bps) 8)))
	  (fmt-chunk channels samplerate bps)
	  (data-chunk bps data)))
  
(defun write-binary (file binary)
  (let ((stream (open file
		      :direction :output
		      :if-exists :supersede
		      :element-type '(unsigned-byte 8))))
    (mapcar (lambda (x) (write-byte x stream))
	    binary)
    (close stream)))

(defun save (file wave &optional (channels 1) (samplerate 48000))
  "Writes an signal to a wav file at the files
current position."
  (write-binary file (wave-struct channels 
				  samplerate 16
				  (float-list-to-binary wave))))

; TODO: Create random name generator to re-enable functions below

;(defun play~ (wave &optional (channels 1) (samplerate 48000))
;  "Play the sound of a signal. Used for testing."
;  (sb-thread:make-thread
;   (lambda ()
;     (let* ((filename (tmpnam (cffi:null-pointer)))
;	    (file (create-wav-file filename channels samplerate)))
;       (save~ file wave)
;       (close-file file)
;       (sb-ext:run-program "/usr/bin/play" (list filename))
;       (delete-file filename)))))

;(defmacro quick-save~ (filename wave channels &optional (samplerate 48000))
;  "Quickly write a signal to a new file before closing it.
;Used for testing."
;  `(let ((file (create-wav-file ,filename ,channels ,samplerate)))
;     (save~ file ,wave)
;     (close-file file)))

(defun plot (wave)
  (let* ((filename "plottmp.plot")
	 (stream (open filename :direction :output
		       :if-exists :supersede)))
    (format stream "~{~a~%~}" wave)
    (close stream)
    (sb-ext:run-program "/usr/bin/gnuplot"
			(list "-p" "-e" 
			      (format nil "plot '~a' with lines" filename)))))
